home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / soundu / dilaudid.zip / PLAYENGN.BAS < prev    next >
BASIC Source File  |  1993-11-17  |  7KB  |  218 lines
  1. DECLARE SUB doplay (dat$)
  2. DECLARE SUB d1 ()
  3. DECLARE SUB d2 ()
  4. DECLARE SUB playnote (note$, oct%)
  5. DECLARE SUB stopplay ()
  6. DECLARE SUB setoptions (am%, vibrato%, sustain%, harmonic%)
  7. DECLARE SUB setlevel (level%)
  8. DECLARE SUB setad (attack%, decay%)
  9. DECLARE SUB setsr (sustain%, release%)
  10. DECLARE SUB setwave (wavetype%)
  11. DECLARE SUB delay ()
  12. DEFINT A-Z
  13. COMMON SHARED curvoice, curoctave, curlength, deflength, curtempo
  14.  
  15. curtempo = 120
  16.  
  17. file$ = COMMAND$
  18. IF file$ = "" THEN
  19.         PRINT "playengn FILENAME"
  20.         END
  21. END IF
  22.  
  23. deflength = 16  'quarter note default
  24.  
  25. FOR curvoice = 0 TO 2
  26.         setoptions 0, 0, 0, 1
  27.         setlevel 60
  28.         setad 9, 2
  29.         setsr 4, 4
  30.         setwave 0
  31. NEXT
  32. curvoice = 0
  33.  
  34. CLS
  35.  
  36. OPEN file$ FOR INPUT AS #1
  37.  
  38. DO
  39.         IF NOT (EOF(1)) THEN INPUT #1, x$
  40.         doplay x$
  41. LOOP UNTIL EOF(1) OR INKEY$ <> ""
  42.  
  43. CLOSE
  44.  
  45. SUB d1
  46.         FOR r = 1 TO 6: x = INP(&H388): NEXT
  47. END SUB
  48.  
  49. SUB d2
  50.         FOR r = 1 TO 35: x = INP(&H388): NEXT
  51. END SUB
  52.  
  53. SUB delay
  54.         x# = (1 / curlength) * (60 / curtempo)
  55.         xx# = TIMER + x#
  56.         DO UNTIL TIMER > xx#: LOOP
  57. END SUB
  58.  
  59. SUB doplay (dat$)
  60.         curvoice = curvoice + 1
  61.         IF curvoice = 3 THEN curvoice = 0
  62.  
  63.         COLOR 7
  64.         x$ = LTRIM$(RTRIM$(LCASE$(dat$))) + " "
  65.         SELECT CASE MID$(x$, 1, 1)
  66.                 CASE "o"        'octave change
  67.                         curoctave = VAL(MID$(x$, 2))
  68.                         PRINT x$ + " ";
  69.                 CASE "m"        'legato, normal, stacato
  70.                         PRINT x$ + " ";
  71.                 CASE "l"        'length
  72.                         deflength = VAL(MID$(x$, 2))
  73.                         PRINT x$ + " ";
  74.                 CASE "p"        'pause
  75.                         curlength = VAL(MID$(x$, 2))
  76.                         delay
  77.                         PRINT x$ + " ";
  78.                 CASE ">"        'up octave
  79.                         PRINT x$ + " ";
  80.                 CASE "<"        'dn octave
  81.                         PRINT x$ + " ";
  82.                 CASE "t"        'tempo
  83.                         curtempo = VAL(MID$(x$, 2))
  84.                         PRINT x$ + " ";
  85.                 CASE "a" TO "g" 'note
  86.                         IF MID$(x$, 2, 1) = "#" OR MID$(x$, 2, 1) = "+" OR MID$(x$, 2, 1) = "-" THEN
  87.                                 n$ = MID$(x$, 1, 2)
  88.                                 curlength = VAL(MID$(x$, 3))
  89.                         ELSE
  90.                                 n$ = MID$(x$, 1, 1)
  91.                                 curlength = VAL(MID$(x$, 2))
  92.                         END IF
  93.                         IF curlength = 0 THEN curlength = deflength
  94.                         stopplay
  95.                         playnote n$, curoctave
  96.                         COLOR 15
  97.                         PRINT n$ + "/o" + LTRIM$(RTRIM$(STR$(curoctave))) + "/d" + LTRIM$(RTRIM$(STR$(curlength))) + " ";
  98.                         delay
  99.                 CASE ELSE
  100.                         COLOR 12
  101.                         PRINT x$ + " ";
  102.         END SELECT
  103. END SUB
  104.  
  105. SUB playnote (note$, oct)
  106. SELECT CASE LCASE$(note$)
  107.         CASE "c#", "c+", "d-"
  108.                 msb = &H1: lsb = &H6B
  109.         CASE "d"
  110.                 msb = &H1: lsb = &H81
  111.         CASE "d#", "d+", "e-"
  112.                 msb = &H1: lsb = &H98
  113.         CASE "e"
  114.                 msb = &H1: lsb = &HB0
  115.         CASE "f"
  116.                 msb = &H1: lsb = &HCA
  117.         CASE "f#", "f+", "g-"
  118.                 msb = &H1: lsb = &HE5
  119.         CASE "g"
  120.                 msb = &H2: lsb = &H2
  121.         CASE "g#", "g+", "a-"
  122.                 msb = &H2: lsb = &H20
  123.         CASE "a"
  124.                 msb = &H2: lsb = &H41
  125.         CASE "a#", "a+", "b-"
  126.                 msb = &H2: lsb = &H63
  127.         CASE "b"
  128.                 msb = &H2: lsb = &H87
  129.         CASE "c"
  130.                 msb = &H2: lsb = &HAE
  131.         CASE ELSE
  132.                 COLOR 12
  133.                 PRINT "ERR ";
  134. END SELECT
  135.  
  136.         OUT &H388, &HA0 + curvoice: d1
  137.         OUT &H389, lsb: d2
  138.         OUT &H388, &HA3 + curvoice: d1
  139.         OUT &H389, lsb: d2
  140.  
  141.         OUT &H388, &HB0 + curvoice: d1
  142.         OUT &H389, msb + (oct * 4) + 32: d2
  143.         OUT &H388, &HB3 + curvoice: d1
  144.         OUT &H389, msb + (oct * 4) + 32: d2
  145.  
  146. END SUB
  147.  
  148. SUB setad (attack, decay)
  149.         OUT &H388, &H60 + curvoice: d1
  150.         OUT &H389, (attack * 16) + decay: d2
  151.         OUT &H388, &H63 + curvoice: d1
  152.         OUT &H389, (attack * 16) + decay: d2
  153. END SUB
  154.  
  155. SUB setlevel (level)
  156.         OUT &H388, &H40 + curvoice: d1
  157.         OUT &H389, (63 - level): d2
  158.         OUT &H388, &H43 + curvoice: d1
  159.         OUT &H389, (63 - level): d2
  160. END SUB
  161.  
  162. SUB setoptions (am, vibrato, sustain, harmonic)
  163.         temp = 0
  164.         IF am THEN temp = 128
  165.         IF vibrato THEN temp = temp + 64
  166.         IF sustain THEN temp = temp + 32
  167.         '       harmonic options:
  168.         '            0 - one octave below
  169.         '            1 - at the voice's specified frequency
  170.         '            2 - one octave above
  171.         '            3 - an octave and a fifth above
  172.         '            4 - two octaves above
  173.         '            5 - two octaves and a major third above
  174.         '            6 - two octaves and a fifth above
  175.         '            7 - two octaves and a minor seventh above
  176.         '            8 - three octaves above
  177.         '            9 - three octaves and a major second above
  178.         '           10 - three octaves and a major third above
  179.         '           11 -  "       "     "  "   "     "     "
  180.         '           12 - three octaves and a fifth above
  181.         '           13 -   "      "     "  "   "     "
  182.         '           14 - three octaves and a major seventh above
  183.         '           15 -   "      "     "  "   "      "      "
  184.         temp = temp + harmonic
  185.         OUT &H388, &H20 + curvoice: d1
  186.         OUT &H389, temp: d2
  187.         OUT &H388, &H23 + curvoice: d1
  188.         OUT &H389, temp: d2
  189. END SUB
  190.  
  191. SUB setsr (sustain, release)
  192.         OUT &H388, &H80 + curvoice: d1
  193.         OUT &H389, ((15 - sustain) * 16) + release: d2
  194.         OUT &H388, &H83 + curvoice: d1
  195.         OUT &H389, ((15 - sustain) * 16) + release: d2
  196. END SUB
  197.  
  198. SUB setwave (wavetype)
  199.         OUT &H388, &HE0 + curvoice: d1
  200.         '   ___              ___            ___    ___       _      _
  201.         '  /   \            /   \          /   \  /   \     / |    / |
  202.         ' /_____\_______   /_____\_____   /_____\/_____\   /__|___/__|___
  203.         '        \     /
  204.         '         \___/
  205.         '     -0-             -1-              -2-             -3-
  206.         OUT &H389, wavetype: d2
  207.         OUT &H388, &HE3 + curvoice: d1
  208.         OUT &H389, wavetype: d2
  209. END SUB
  210.  
  211. SUB stopplay
  212.         OUT &H388, &HB0 + curvoice: d1
  213.         OUT &H389, 0: d2
  214.         OUT &H388, &HB3 + curvoice: d1
  215.         OUT &H389, 0: d2
  216. END SUB
  217.  
  218.